home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
euphoria
/
sanity.ex
< prev
next >
Wrap
Text File
|
1994-03-05
|
17KB
|
841 lines
------------------------------------------
-- AUTOMATIC SELF-CHECKING SANITY TEST --
-- for Euphoria --
-- A quick test of most of the features --
------------------------------------------
with type_check
include get.e
include graphics.e
include sort.e
include machine.e
include file.e
trace(0)
constant msg = 1 -- place to send messages
global object y, i, r
procedure the_end()
abort(1)
end procedure
procedure make_sound()
-- test sound() built-in
for i = 500 to 5000 by 500 do
sound(i)
for j = 1 to 100000 do
end for
sound(0)
end for
end procedure
without warning
procedure abort()
-- force abort with trace back
puts(msg, "\ndivide by 0 to get trace back...Press Enter\n")
if sequence(gets(0)) then
end if
? 1/0
end procedure
with warning
procedure show(object x, object y)
-- show the mismatched values
puts(msg, "\n ---MISMATCH--- \n x is ")
? x
puts(msg, " y is ")
? y
abort()
end procedure
constant epsilon = 1e-10 -- allow for small floating point inaccuracy
procedure same(object x, object y)
-- object x must be identical to object y else abort program
atom ratio
if atom(x) and atom(y) then
if x = y then
return
else
if y = 0 then
show(x, y)
else
ratio = x / y
if ratio < 1 - epsilon or ratio > 1 + epsilon then
show(x, y)
end if
end if
end if
elsif length(x) = length(y) then
for i = 1 to length(x) do
same(x[i], y[i])
end for
else
show(x, y)
end if
end procedure
function abs(atom x)
-- absolute value
if x < 0 then
return -x
else
return x
end if
end function
function built_in()
-- built-in tests
sequence d
d = date()
if d[1] < 93 or d[2] > 12 or d[3] < 1 or d[4] > 23 or d[5] > 59 or
d[6] >59 or d[7] > 7 or d[8] > 366 then
abort()
end if
d = power({-5, -4.5, -1, 0, 1, 2, 3.5, 4, 6},
{ 3, 2, -1,0.5, 0, 29, -2.5, 5, 8})
if d[1] != -125 or d[2] != 20.25 or d[3] != -1 or d[4] != 0 then
abort()
end if
if d[5] != 1 or d[6] != 536870912 or d[7] <.043 or d[7] > .044 then
abort()
end if
if d[8] != 1024 or d[9] != 1679616 or power(2,3) != 8 then
abort()
end if
same(power(16, 0.5), 4)
d = remainder({5, 9, 15, -27}, {3, 4, 5, 6})
if d[1] != 2 or d[2] != 1 or d[3] != 0 or d[4] != -3 then
abort()
end if
d = remainder({11.5, -8.8, 3.5, 5.0}, {2, 3.5, -1.5, -100.0})
if d[1] != 1.5 or d[2] < -1.81 or d[2] > -1.79 or d[3] != 0.5 or d[4] != 5 then
abort()
end if
same(4, sqrt(16))
same(3, length("ABC"))
same({1, 1, 1, 1}, repeat(1, 4))
if rand(10) > 10 or rand(20) < 1 or not find(rand(5.5), {1,2,3,4,5}) then
abort()
end if
if time() < 0 then
abort()
end if
if abs(sin(3.1415)) > 0.02 then
abort()
end if
if cos(0) < .98 then
abort()
end if
if abs(tan(3.14/4) - 1) > .02 then
abort()
end if
if log(2.7) < 0.8 or log(2.7) > 1.2 then
abort()
end if
if floor(-3.3) != -4 then
abort()
end if
if floor(-999/3.000000001) != -333 then
abort()
end if
if floor(9.99/1) != 9 then
abort()
end if
for i = -9 to 2 do
if i = 1 then
return i
end if
end for
end function
procedure sub()
y = 200
end procedure
procedure overflow()
-- test overflows from integer into floating point
object two29, two30, maxint, prev_i
integer two30i, mtwo30i
sequence s
two30 = 1
for i = 1 to 30 do
two30 = two30 * 2
end for
s = {two30, two30+1, two30+2}
s = s + s
if compare(s, {two30*2, two30*2+2, two30*2+4}) then
abort()
end if
mtwo30i = -1
for i = 1 to 29 do
mtwo30i = mtwo30i * 2
end for
two30i = 1
for i = 1 to 29 do
two30i = two30i * 2
end for
if 2 * two30i != -2 * mtwo30i then
abort()
end if
if two30i*2 != two30 then
abort()
end if
two29 = floor(two30 / 2)
if two29 + two29 != two30 then
abort()
end if
maxint = floor(two30 - 1)
if maxint + 1 != two30 then
abort()
end if
if 2 + maxint != two30 + 1 then
abort()
end if
if (-maxint - 1) * -1 != two30 then
abort()
end if
prev_i = -maxint + 1
for i = -maxint to -maxint -5 by -1 do
if i != prev_i - 1 then
abort()
end if
prev_i = i
end for
prev_i = maxint - 5
for i = maxint - 3 to maxint + 3 by 2 do
if i != prev_i + 2 then
abort()
end if
prev_i = i
end for
if floor(two30) != two30 then
abort()
end if
if floor(two30 + two30 - 1) != two30 * 2 - 1 then
abort()
end if
end procedure
type natural(integer x)
return x >= 0
end type
procedure atomic_ops()
-- test operations on atoms
object a, x, z
integer n, m
natural p
p = 0
p = 0.000
p = 4.0/2.0
if p != 2.0 then
abort()
end if
n = 1
m = 1
if n and m then
else
abort()
end if
x = 100
sub() -- y = 200
z = 300
if x + y != z then
abort()
end if
if x != 100 then
abort()
end if
if 3 * 3 != 9 or
3 * 900000000 != 2700000000 or
15000 * 32000 != 480000000 or
32000 * 15000 != 480000000 or
1000 * 13000 != 13000000 or
13000 * 1000 != 13000000 then
abort()
end if
while x != 100 do
abort()
end while
if not (z - y = 100) then
abort()
end if
if #FFFFFFFF != 4294967295 then
abort()
end if
p = 20
while not (p < 10) do
p = p - 2
end while
if p != 8 then
abort()
end if
if x * 1000.5 != 100050 or x * y != 20000 or x / y != 0.5 then
abort()
end if
if y < x then
abort()
end if
if y <= x then
abort()
end if
if x > y then
abort()
end if
if x >= y then
abort()
end if
if -x != -100 then
abort()
end if
if x = x and y > z then
abort()
end if
x = 0
y = {"ten", "one", "two", "three", "four", "five", "six", "seven", "eight",
"nine", "ten", "ten"}
while x <= 11 do
if x = 1 then a = "one"
elsif x = 2 then a = "two"
elsif x = 3 then a = "three"
elsif x = 4 then a = "four"
elsif x = 5 then a = "five"
elsif x = 6 then a = "six"
elsif x = 7 then a = "seven"
if 1 + 1 = 2 then
same(a, "seven")
elsif 1 + 1 = 3 then
abort()
else
abort()
end if
elsif x = 8 then a = "eight"
elsif x = 9 then a = "nine"
else a = "ten"
end if
same(a, y[1+x])
x = x + 1
end while
y = 0
for xx = 100 to 0 by -2 do
y = y + xx
end for
same(y, 50 * 51)
for xx = 1 to 10 do
if xx = 6 then
x = 6
exit
end if
y = 1
while y < 25 do
y = y + 1
if y = 18 then
exit
end if
end while
same(y, 18)
end for
y = repeat(-99, 7)
for xx = +3 to -3 by -1 do
y[xx+4] = xx
end for
same(y, {-3, -2, -1, 0, +1, +2, +3})
y = {1,2,3}
for xx = 1.5 to +3.0 by .5 do
y[xx] = xx
end for
same(y, {1.5, 2.5, 3.0})
y = {}
for xx = -9.0 to -9.5 by -.25 do
y = y & xx
end for
same(y, {-9, -9.25, -9.5})
y = {}
for i = 800000000 to 900000000 by 800000000 do
y = append(y, i)
end for
if compare(y, {800000000}) then
abort()
end if
y = 5
n = 3
a = 2
for i = 1 to y by a do
n = n - 1
y = 155
a = 1
end for
same(n, 0)
end procedure
procedure floating_pt()
-- test floating-point operations
sequence x
x = {1.5, -3.5, 1e10, -1e20, 0.0, 0.0001}
y = repeat(x, 10)
if x[1]/x[2] > -0.42 or x[1]/x[2] < -0.43 then
abort()
end if
if find(1e10, x) != 3 then
abort()
end if
end procedure
function one()
return 1
end function
function two()
return 2.000
end function
function sequence_ops()
-- test operations on sequences
object i, w, x, y, z
sequence s
integer j
x = "Hello "
y = "World"
if find(0, x = x) then
abort()
end if
if x[two()*two() - two()] != 'e' then
abort()
end if
if x[one()+one()] != x[two()] then
abort()
end if
j = x[1]
if j != 'H' then
abort()
end if
s = {3.0}
s[1] = 1.0000
j = s[1]
if j != 1 then
abort()
end if
i = 1
if not atom(i) or not integer(i) then
abort()
end if
if length(y) != 5 then
abort()
end if
while i <= 5 do
x = append(x, y[i])
i = i + 1
end while
i = 1
while i <= 3 do
x = append(x, '.')
x = append(x, '\'')
i = i + 1
end while
same(x, "Hello World.'.'.'")
x = repeat(5, 19)
x = append(x, 20)
x[7] = 9
y = {9, 9, {9}}
y = prepend(y, 8)
y = prepend(y, {9, 9})
same(y, {{9, 9}, 8, 9, 9, {9}})
y = x
z = y * x + x + 1000
w = z > 1030 or x = 9
same(z, {1030, 1030, 1030, 1030, 1030, 1030, 1090, 1030, 1030, 1030,
1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1420})
same(w, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1})
x = {100, 200, {1, 2, {0, 0, 0}}, 300}
x[3][3][3] = 25
x = x * x
same(x, {10000, 40000, {1, 4, {0, 0, 625}}, 90000})
y = x / {1, 2, 3, 4}
same(y, {10000, 20000, {1/3, 4/3, {0, 0, 625/3}}, 22500})
-- & tests
same(2 & {5, 6,7}, {2, 5, 6, 7})
same({} & 3, {3})
same("ABC" & "DEF" & "GHIJ" & {}, "ABCDEFGHIJ")
same('A' & 'B' & 'C', "ABC")
-- slice tests
x = "ABCDEFGHIJKLMNOP"
same(x[1..4], "ABCD")
y = x[2..5]
same(y, "BCDE")
same(x[4..3], {})
same(x[4..4], "D")
x[3..5] = "000"
same(x, "AB000FGHIJKLMNOP")
x[6..9] = '8'
same(x, "AB0008888JKLMNOP")
same(floor({1, 2, -3, 4, -5} / 3), {0, 0, -1, 1, -2})
return y
end function
procedure sequence_ops2()
-- more tests of sequence operations
object x, y
x = "ABCDEFGHIJKLMNOP"
if find('D', x) != 4 then
abort()
end if
if match("EFGH", x) != 5 then
abort()
end if
if match({"AB", "CD"}, {0, 1, 3, {}, {"AB", "C"}, "AB", "CD", "EF"}) != 6 then
abort()
end if
if compare(x,x) != 0 then
abort()
end if
if compare({}, {}) != 0 then
abort()
end if
y = repeat(repeat(repeat(99, 5), 5), 5)
if y[3][3][3] != 99 then
abort()
end if
if compare(y[4][4][3..5], repeat(99, 3)) != 0 then
abort()
end if
y[3][2][1..4] = 88
if compare(y[3][2], {88, 88, 88, 88, 99}) != 0 then
abort()
end if
end procedure
procedure circularity()
-- test for circular references in internal garbage collector
object x, y
x = {{"abc", {0, 0, 0}}, "def", 1, 2}
x[3] = x
x[1..2] = x[2..3]
x = append(x, x)
x = prepend(x, x)
if compare(x, x) != 0 then
abort()
end if
y = "ABCDE"
y[2] = repeat(y, 3)
if compare(y, y) != 0 then
abort()
end if
end procedure
procedure output()
-- test file output routines
integer file_no
file_no = open("sanityio.tst", "w")
if file_no < 0 then
abort()
end if
puts(file_no, "-- io test\n")
print(file_no, {1,2,3})
print(file_no, -99)
puts(file_no, "{11, {33, {#33}}, 4, 5 }{\t\t}\n")
puts(file_no, "{}.999 -.999 1.55e00 {11, 22 , {33, 33}, 4, 5 }\n")
printf(file_no, "%e", 10000)
printf(file_no, "%d", -123)
printf(file_no, "%5.1f", 5+1/2)
printf(file_no, "%50s\n", {"+99 1001 {1,2,3} 1E-4 {1.002e23,-59e-5,"})
printf(file_no, "%9e}\t\t-1e-20\t -.00001e5\n", 59e30)
puts(file_no, "\"Rob\"\"ert\" \"Craig\" ")
puts(file_no, "\"\" \"\\n\" \"\\t\\r\"\t")
puts(file_no, "\"\\'\\\"\" 'A' '\\n' '\\\"' '\\'' '\\r'\n")
printf(file_no, "{#%x, ", 291)
puts(file_no, "\"ABC\"} {'A', 'B', '\\n'}")
close(file_no)
end procedure
procedure input()
-- test file input routines
integer file_no
object line
integer char
file_no = open("sanityio.tst", "r")
if file_no < 0 then
abort()
end if
if seek(file_no, 5) then
abort()
end if
if seek(file_no, -1) then
abort()
end if
if seek(file_no, 0) then
abort()
end if
if where(file_no) != 0 then
abort()
end if
line = gets(file_no)
if compare(line, "-- io test\n") != 0 then
abort()
end if
char = getc(file_no)
if char != '{' then
abort()
end if
close(file_no)
end procedure
procedure testgr()
-- test basic VGA graphics operations
sequence v
v = video_config()
if v[VC_XPIXELS] < 100 or v[VC_YPIXELS] < 100 then
abort()
end if
draw_line(1, {{20, 100}, {600, 100}})
for i = 1 to 200 by 5 do
pixel(7, {3*i, i})
if get_pixel({3*i, i}) != 7 then
abort()
end if
end for
end procedure
constant TRUE = 1, FALSE = 0
procedure testget()
-- test input of Euphoria objects
object gd
object x, i
object results
gd = open("sanityio.tst", "r")
if gd < 0 or gd > 10 then
abort()
end if
if not sequence(gets(gd)) then
abort()
end if
results = {
{0, {1,2,3}},
{0, -99},
{0, {11, {33, {#33}}, 4, 5}},
{0, {}},
{0, {}},
{0, 0.999},
{0, -0.999},
{0, 1.55},
{0, {11, 22, {33, 33}, 4, 5}},
{0, 10000},
{0, -123},
{0, 5.5},
{0, 99},
{0, 1001},
{0, {1, 2, 3}},
{0, 0.0001},
{0, {1.002e+23, -0.00059, 5.9e+31}},
{0, -1e-20},
{0, -1},
{0, "Rob"},
{0, "ert"},
{0, "Craig"},
{0, ""},
{0, "\n"},
{0, "\t\r"},
{0, "\'\""},
{0, 'A'},
{0, '\n'},
{0, '\"'},
{0, '\''},
{0, '\r'},
{0, {#123, "ABC"}},
{0, {'A', 'B', '\n'}},
{-#1, 0}
}
i = 1
while TRUE do
x = get(gd)
if x[1] = -1 then
exit
end if
same(x, results[i])
i = i + 1
end while
if compare(results[i], {-1, 0}) != 0 then
puts(2, "wrong number of get values\n")
end if
close(gd)
end procedure
function fib(integer n)
-- fibonacci
if n < 2 then
return n
else
return fib(n-1) + fib(n-2)
end if
end function
integer rp
procedure recursive_proc()
-- a recursively-called procedure
if rp > 0 then
rp = rp - 1
recursive_proc()
end if
end procedure
procedure machine_level()
-- quick test of machine-level routines
atom addr
addr = allocate(100)
poke(addr, #C3) -- RET instruction
if peek(addr) != #C3 then
abort()
end if
call(addr)
free(addr)
for x = 0 to +2000000 by 49999 do
if bytes_to_int(int_to_bytes(x)) != x then
abort()
end if
end for
end procedure
global type sorted(sequence x)
-- return TRUE if x is in ascending order
for i = 1 to length(x)-1 do
if compare(x[i], x[i+1]) > 0 then
return FALSE
end if
end for
return TRUE
end type
without profile
global procedure sanity()
-- main program
sequence cmd_line
integer vga
vga = not graphics_mode(18)
clear_screen()
position(12, 20)
puts(msg, "Euphoria SANITY TEST ... ")
for j = 0 to 8 by 2 do
if atom(getenv("EUDIR")) then
puts(1, "EUDIR not set\n")
abort()
end if
cmd_line = command_line()
if length(cmd_line) < 1 or length(cmd_line) > 10 then
abort()
end if
if length(current_dir()) < 2 then
abort()
end if
if length(dir(".")) < 2 then
abort()
end if
if vga then
testgr()
end if
make_sound()
same(built_in(), 1)
atomic_ops()
overflow()
floating_pt()
if compare(sequence_ops(), "BCDE") != 0 then
puts(msg, "sequence_ops failed\n")
end if
sequence_ops2()
circularity()
output()
input()
testget()
system("del sanityio.tst", 2)
machine_level()
rp = 100
recursive_proc()
if rp != 0 then
puts(msg, "recursive proc failed\n")
end if
if fib(20) != 6765 then
puts(msg, "fib failed\n")
end if
if not sorted(sort(-500 + rand(repeat(1000, 1000)))) then
puts(msg, "standard sort failed\n")
end if
if not sorted(sort({"robert", "junko", "dave", "ken", "lurdes"})) then
puts(msg, "standard general sort failed\n")
end if
end for
printf(msg, "%s\n", {"PASSED (100%)\n\n <Enter> to continue"})
if atom(gets(0)) then
end if
if graphics_mode(-1) then
end if
the_end()
end procedure
integer z
-- another for-loop test
z = 0
for j = 1 to 10 do
z = z + j
end for
if z != 55 then
abort()
end if
sanity()